home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / ZIPCRK10.ZIP / ZIPCRACK.PAS < prev   
Pascal/Delphi Source File  |  1993-03-17  |  21KB  |  684 lines
  1. program zipcrack;
  2.  
  3. {$M 16384, 0, 65536}
  4.  
  5. {-----------------------------------------------------------------------}
  6. {                                                                        }
  7. { Program ZIPCRACK Copyright 1993 by Michael A. Quinlan                    }
  8. {                                                                        }
  9. { Brute force attack on PKZIP V2 encryption.                            }
  10. { Based on the APPNOTE.TXT distributed with the registered version        }
  11. { of PKZIP 2.04g.                                                        }
  12. {                                                                        }
  13. { Method: Generate all possible passwords; invoke PKUNZIP -t (test)        }
  14. { option to test each password.                                            }
  15. {                                                                        }
  16. { Input: Minimum and maximum password lengths, password character set,    }
  17. { Zipfile name, name of file to extract.                                }
  18. {                                                                        }
  19. { Options: Interval to save last password attempted; this allows the    }
  20. { program to be restarted.                                                }
  21. {                                                                        }
  22. { Performance improvements: placing PKUNZIP and the Zipfile on a RAM    }
  23. { disk will improve speed. Increasing the 'save' interval will also        }
  24. { increase speed. Making the current directory a RAM disk is _NOT_        }
  25. { recommended, since a crash (power hit, etc.) will lose the saved        }
  26. { 'last password' and you will have to restart from scratch.            }
  27. {                                                                        }
  28. {-----------------------------------------------------------------------}
  29.  
  30. uses
  31.     DOS,
  32.     CRT;
  33.  
  34. const
  35.     SaveFN        = 'ZIPCRACK.$$$';        { Save file name                }
  36.     WorkDir        = '\ZIPCRACK';            { Work Subdirectory                }
  37.     MAXPW        = 256;                    { Max Password Length            }
  38.     MAXBUF        = 32768;                { Max buffer length                }
  39.     K0             = 305419896;            { Zipfile Encryption Initializer}
  40.     K1             = 591751049;            { Zipfile Encryption Initializer}
  41.     K2             = 878082192;            { Zipfile Encryption Initializer}
  42.     ZIPHDRSIG    = $04034B50;            { Zip Local Header Signature    }
  43.     ZDHDRSIG    = $02014B50;            { Zip Directory Header Signature}
  44.     ZDENDSIG    = $06054B50;            { Zip Directory End Signature    }
  45.  
  46. const
  47.     CrcTab : array [0..255] of LongInt =    
  48.         (
  49.             $00000000, $77073096, $EE0E612C, $990951BA,
  50.             $076DC419, $706AF48F, $E963A535, $9E6495A3,
  51.             $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
  52.             $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
  53.             $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
  54.             $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
  55.             $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
  56.             $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
  57.             $3B6E20C8, $4C69105E, $D56041E4, $A2677172,
  58.             $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
  59.             $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
  60.             $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
  61.             $26D930AC, $51DE003A, $C8D75180, $BFD06116,
  62.             $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
  63.             $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
  64.             $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
  65.             $76DC4190, $01DB7106, $98D220BC, $EFD5102A,
  66.             $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
  67.             $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
  68.             $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
  69.             $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
  70.             $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
  71.             $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
  72.             $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
  73.             $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
  74.             $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
  75.             $4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
  76.             $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
  77.             $5005713C, $270241AA, $BE0B1010, $C90C2086,
  78.             $5768B525, $206F85B3, $B966D409, $CE61E49F,
  79.             $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
  80.             $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
  81.             $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
  82.             $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
  83.             $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
  84.             $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
  85.             $F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
  86.             $F762575D, $806567CB, $196C3671, $6E6B06E7,
  87.             $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
  88.             $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
  89.             $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
  90.             $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
  91.             $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
  92.             $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
  93.             $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
  94.             $CC0C7795, $BB0B4703, $220216B9, $5505262F,
  95.             $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
  96.             $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
  97.             $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
  98.             $9C0906A9, $EB0E363F, $72076785, $05005713,
  99.             $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
  100.             $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
  101.             $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
  102.             $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
  103.             $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
  104.             $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
  105.             $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
  106.             $A7672661, $D06016F7, $4969474D, $3E6E77DB,
  107.             $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
  108.             $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
  109.             $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
  110.             $BAD03605, $CDD70693, $54DE5729, $23D967BF,
  111.             $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
  112.             $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D
  113.         );
  114.  
  115. type
  116.     CopyBufT    = array [1..MAXBUF] of char;{ Copy Buffer                }
  117.     CopyBufTP    = ^COpyBufT;                { Ptr to Copy Buffer        }
  118.     Buf12T      = array [0..11] of Char;    { 12-byte buffer            }
  119.     SetOfCharT    = Set of Char;                { Set of characters            }
  120.     CharArrayT    = Array [0..255] of Char;    { List of characters        }    
  121.     CharSetT    = record                    { Character Set for Zip PW    }
  122.                     n : 0..256;                { ..# of chars in the set    }    
  123.                     c : CharArrayT;            { ..List of PW chars        }
  124.                     s : SetOfCharT;            { ..PW chars in set format    }
  125.                   end;
  126.     ZipHdrT     = record                    { Zip File Header            }
  127.                     Sig        : LongInt;        { ..Signature                }
  128.                     VerReqd    : Word;            { ..Version reqd to unzip    }
  129.                     BitFlag    : Word;            { ..Bit Flag                }
  130.                     Method    : Word;            { ..Compress Method            }
  131.                     LModTime: Word;            { ..Last Mod Time            }
  132.                     LModDate: Word;            { ..Last Mod Date            }
  133.                     CRC32    : LongInt;        { ..File CRC                }
  134.                     CmpSize : LongInt;        { ..Compressed Size            }
  135.                     UncmpSz    : LongInt;        { ..Uncompressed Size        }
  136.                     FNLen    : Word;            { ..File Name Length        }
  137.                     EFLen    : Word;            { ..Extra Field Length        }
  138.                   end;
  139.     ZDHdrT        = Record                    { Directory File Header        }
  140.                     Sig        : LongInt;        { ..Signature                }
  141.                     Version    : Word;            { ..Version made by            }
  142.                     VerReqd    : Word;            { ..Version reqd to extract    }
  143.                     BitFlag    : Word;            { ..Bit Flag                }
  144.                     Method    : Word;            { ..Compression Method        }
  145.                     LModTime: Word;            { ..Last Mod time            }
  146.                     LModDate: Word;            { ..Last Mod Date            }
  147.                     CRC32    : LongInt;        { ..CRC or 0                }
  148.                     CmpSize    : LongInt;        { ..Compressed Size            }
  149.                     UncmpSz    : LongInt;        { ..Uncompressed Size        }
  150.                     FNLen    : Word;            { ..File Name Length        }
  151.                     EFLen    : Word;            { ..Extra Field Length        }
  152.                     FCLen    : Word;            { ..File Comment Length        }
  153.                     DiskNo    : Word;            { ..Starting Disk Number    }
  154.                     IFAttr    : Word;            { ..Internal File Attributes}
  155.                     EFAttr    : LongInt;        { ..External File Attributes}
  156.                     LHOff    : LongInt;        { ..Offset of local header    }
  157.                   end;
  158.     ZDEndT         = Record                    { Directory End Record        }
  159.                     Sig        : LongInt;        { ..Signature                }
  160.                     DiskNo    : Word;            { ..Number of this disk        }
  161.                     ZDDisk    : Word;            { ..Disk w/ start of dir    }
  162.                     ZDETD    : Word;            { ..Dir ents this disk        }
  163.                     ZDEnts    : Word;            { ..Total dir ents            }
  164.                     ZDSize    : LongInt;        { ..Dir size                }
  165.                     ZDStart    : LongInt;        { ..Offset to start of Dir    }
  166.                     CmtLen    : Word;            { ..Zip Comment Length        }
  167.                   end;
  168.  
  169. var    PkunzipPath : String;                { Path & File name for PKUNZIP    }
  170.     ZipfilePath    : String;                { Path & File name for Zipfile    }
  171.     ZipfileName    : String;                { File name for Zipfile            }
  172.     RamPath        : String;                { Path on RAM Drive                }
  173.     MemberName    : String;                { Zipfile Member Name            }
  174.     MinPWLen    : Integer;                { Minimum password length        }
  175.     MaxPWLen    : Integer;                { Maximum password length        }
  176.     PWCharSet    : CharSetT;                { Password character set        }
  177.     PWSaveInt    : LongInt;                { Password Save Interval        }
  178.     UseRamDisk    : Boolean;                { Use RAM Disk?                    }
  179.     RamDrive    : Char;                    { Ram Disk Drive Letter            }
  180.     NextPW        : array [1..MAXPW] of Byte;{ Next password to try        }
  181.     rc             : Integer;
  182.     PWLen        : Integer;
  183.     PW            : String;
  184.     Key0        : LongInt;                { Zip Encryption Key 0            }
  185.     Key1        : LongInt;                { Zip Encryption Key 1            }
  186.     Key2        : LongInt;                { Zip Encryption Key 2            }
  187.     ZipBuf        : Buf12T;                { Zip Encryption Buffer            }
  188.     ZipFile        : File;
  189.     ZDEnd        : ZDEndT;                { Zip Directory End Record        }
  190.     ZDHdr        : ZDHdrT;                { Zip Directory Header Record    }
  191.     ZipHdr        : ZipHdrT;                { Zip Local Header Record        }
  192.     Ok            : Boolean;
  193.  
  194.  
  195. function crc32(crc : LongInt; c : Char) : LongInt;
  196. begin
  197.     crc32 := ((crc shr 8) and $00FFFFFF) xor CrcTab[(Ord(c) xor (crc and $00FF))  and $00FF];
  198. end;
  199.  
  200. procedure ZipPWUpdateKeys(C : Char);
  201. begin
  202.     Key0 := crc32(Key0, C);
  203.     Key1 := Key1 + (Key0 and $000000FF);
  204.     Key1 := Key1 * 134775813 + 1;
  205.     Key2 := crc32(Key2, Chr((Key1 shr 24) and $000000FF));
  206. end;
  207.  
  208. function ZipPWDecryptByte : Char;
  209. var Temp : Word;
  210. begin
  211.     Temp := (Key2 or 2) and $0000FFFF;
  212.     ZipPWDecryptByte := Chr(((Temp * (Temp xor 1)) shr 8) and $00FF);
  213. end;
  214.  
  215. procedure ZipPWInitKeys(PW : String);
  216. var n : Integer;
  217. begin
  218.     Key0 := K0;
  219.     Key1 := K1;
  220.     Key2 := K2;
  221.     for n := 1 to Length(PW) do ZipPWUpdateKeys(PW[n]);
  222. end;
  223.  
  224. procedure ZipPWUpdateBuf(var Buf : Buf12T);
  225. var i : Integer;
  226.     c : Char;
  227. begin
  228.     for i := 0 to 11 do begin
  229.         c := Chr(Ord(Buf[i]) xor Ord(ZipPWDecryptByte));
  230.         ZipPWUpdateKeys(c);
  231.         Buf[i] := c;
  232.     end;
  233. end;
  234.  
  235. function ZipPWCheck(PW : String; Buf : Buf12T; crc : LongInt) : Boolean;
  236. begin
  237.     ZipPWInitKeys(PW);
  238.     ZipPWUpdateBuf(Buf);
  239.     ZipPWCheck := Ord(Buf[11]) = ((crc shr 24) and $000000FF);
  240. end;
  241.  
  242. function ZipOpen(var F : File; Name : String; var ZDEnd : ZDEndT) : Boolean;
  243. var FMSave     : Word;
  244.     SeekPos    : LongInt;
  245. begin
  246.     if Pos('.', Name) = 0 then Name := Name + '.ZIP';
  247.     Assign(F, Name);
  248.     FMSave := FileMode;
  249.     FileMode := 0;
  250.     {$I-} Reset(F, 1); {$I+}
  251.     FileMode := FMSave;
  252.     if IOResult <> 0 then begin
  253.          WriteLn(Name, ': Cannot open file');
  254.         ZipOpen := FALSE;
  255.         Exit;
  256.     end;
  257.     SeekPos := FileSize(F) - sizeof(ZDEnd) + 1;
  258.     while TRUE do begin
  259.         if SeekPos <= 0 then begin
  260.             WriteLn(Name, ': Cannot find ZIP Directory');
  261.             Close(F);
  262.             ZipOpen := FALSE;
  263.             Exit;
  264.         end;
  265.         Dec(SeekPos);
  266.         Seek(F, SeekPos);
  267.         BlockRead(F, ZDEnd, sizeof(ZDEnd));
  268.         if ZDEnd.Sig = ZDENDSIG then begin
  269.             ZipOpen := TRUE;
  270.             Exit;
  271.         end;
  272.     end;
  273. end;
  274.  
  275. function ZipFindZDHdr(var F : File; Name : String; var ZDEnd : ZDEndT; var ZDHdr : ZDHdrT) : Boolean;
  276. var n        : Word;
  277.     SeekPos    : LongInt;
  278.     Buf        : String;
  279.     FNLen    : Integer;
  280.     i        : Integer;
  281. begin
  282.     FNLen := Length(Name);
  283.     Buf[0] := Chr(FNLen);
  284.     for i := 1 to FNLen do Name[i] := UpCase(Name[i]);
  285.     SeekPos := ZDEnd.ZDStart;
  286.     for n := 1 to ZDEnd.ZDEnts do begin
  287.         Seek(F, SeekPos);
  288.         BlockRead(F, ZDHdr, sizeof(ZDHdr));
  289.         if ZDHdr.FNLen = FNLen then begin
  290.             BlockRead(F, Buf[1], FNLen);
  291.             for i := 1 to FNLen do Buf[i] := UpCase(Buf[i]);
  292.             if Name = Buf then begin
  293.                 ZipFindZDHdr := TRUE;
  294.                 Exit;
  295.             end;
  296.         end;
  297.         SeekPos := SeekPos + sizeof(ZDHdr) + ZDHdr.FNLen + ZDHdr.EFLen + ZDHdr.FCLen;
  298.     end;
  299.     ZipFindZDHdr := FALSE;
  300. end;
  301.  
  302. function ZipFindFile(var F : File; Name : String; var ZDEnd : ZDEndT; var ZDHdr : ZDHdrT; var ZipHdr : ZipHdrT) : Boolean;
  303. var Ok : Boolean;
  304. begin
  305.     Ok := ZipFindZDHdr(F, Name, ZDEnd, ZDHdr);
  306.     if not Ok then begin
  307.         ZipFindFile := FALSE;
  308.         Exit;
  309.     end;
  310.     Seek(F, ZDHdr.LHOff);
  311.     BlockRead(F, ZipHdr, sizeof(ZipHdr));
  312.     Seek(F, ZDHdr.LHOff + sizeof(ZipHdr) + ZipHdr.FNLen + ZipHdr.EFLen);
  313.     ZipFindFile := TRUE;
  314. end;
  315.  
  316. procedure AddCharToCharSet(var SC : CharSetT; c : Char);
  317. begin
  318.     if SC.n = 0 then SC.s := [];
  319.     if not (c in SC.s) then begin
  320.         SC.c[SC.n] := c;
  321.         SC.s := SC.s + [c];
  322.         inc(SC.n);
  323.     end;
  324. end;
  325.  
  326. procedure AddStringToCharSet(var SC : CharSetT; S : String);
  327. var n : Integer;
  328. begin
  329.     for n := 1 to length(S) do AddCharToCharSet(SC, S[n]);
  330. end;
  331.  
  332. procedure AddSetToCharSet(var SC : CharSetT; S : SetOfCharT);
  333. var n : Integer;
  334. begin
  335.     for n := 0 to 255 do begin
  336.         if Chr(n) in S then AddCharToCharSet(SC, Chr(n));
  337.     end;
  338. end;
  339.  
  340. function PromptChar(p : String; r : String) : Char;
  341. var K     : Char;
  342.     S     : String;
  343.     Done : Boolean;
  344. begin
  345.     Done := FALSE;
  346.     while not Done do begin
  347.         Write(p, '? ');
  348.         ReadLn(S);
  349.         if length(s) = 0 then K := #$00
  350.         else K := S[1];
  351.         if Pos(K, r) <> 0 then Done := TRUE
  352.         else WriteLn('Enter one of: ', r);
  353.     end;
  354.     PromptChar := K;
  355. end;
  356.  
  357. function PromptString(p : String) : String;
  358. var S : String;
  359. begin
  360.     Write(p, '? ');
  361.     ReadLn(S);
  362.     PromptString := S;
  363. end;
  364.  
  365. function PromptNumber(p : String; Min, Max : LongInt) : LongInt;
  366. var S     : String;
  367.     Code : Integer;
  368.     R     : LongInt;
  369.     Done : Boolean;
  370. begin
  371.     Done := FALSE;
  372.     while not Done do begin
  373.         S := PromptString(p);
  374.         val(S, R, Code);
  375.         if (Code <> 0) or (R < Min) or (R > Max) then
  376.             WriteLn('Enter an integer from ', Min, ' to ', Max)
  377.         else Done := TRUE;
  378.     end;
  379.     PromptNumber := R;
  380. end;
  381.  
  382. procedure PromptCharSet(p : String; var SC : CharSetT);
  383. var K     : Char;
  384. begin
  385.     SC.n := 0;
  386.     WriteLn(p, ':');
  387.     K := PromptChar('  Lower case letters [a..z]', 'YyNn');
  388.     if UpCase(K) = 'Y' then AddSetToCharSet(SC, ['a'..'z']);
  389.     K := PromptChar('  Upper case letters [A..Z]', 'YyNn');
  390.     if UpCase(K) = 'Y' then AddSetToCharSet(SC, ['A'..'Z']);
  391.     K := PromptChar('  Digits [0..9]', 'YyNn');
  392.     if UpCase(K) = 'Y' then AddSetToCharSet(SC, ['0'..'9']);
  393.     K := PromptChar('  Blank', 'YyNn');
  394.     if UpCase(K) = 'Y' then AddStringToCharSet(SC, ' ');
  395.     K := PromptChar('  Punctuation and special characters', 'YyNn');
  396.     if UpCase(K) = 'Y' then AddStringToCharSet(SC, '`~!@#$%^&*()_-+=[{]}\|;:",<.>/?''');
  397. end;
  398.  
  399. function PromptFilename(p : String; ext : String; path : String) : String;
  400. var fn     : String;
  401.     fn2     : String;
  402.     Done : Boolean;
  403.     i     : Integer;
  404. begin
  405.     Done := FALSE;
  406.     while not DONE do begin
  407.         fn := PromptString(p);
  408.         if pos('.', fn) = 0 then fn := fn + '.' + ext;
  409.         for i:=1 to length(fn) do fn[i] := UpCase(fn[i]);
  410.         fn2 := FSearch(fn, path);
  411.         if fn2 = '' then WriteLn('Unable to locate ', fn)
  412.         else Done := TRUE;
  413.     end;
  414.     fn := FExpand(fn2);
  415.     for i:=1 to length(fn) do fn[i] := UpCase(fn[i]);
  416.     PromptFilename := fn;
  417. end;
  418.  
  419. function GetRestartData : Boolean;
  420. var Key      : Char;
  421.     SaveF : File;
  422. begin
  423.     FillChar(NextPW, MAXPW, 0);
  424.     MinPWLen := 0;
  425.     MaxPWLen := 0;
  426.     PWCharSet.n := 0;
  427.     PWLen := 0;
  428.     GetRestartData := FALSE;
  429.     if (FSearch(SaveFN, '') <> '') then begin
  430.         Key := PromptChar('Restart from last password', 'YyNn');
  431.         if upcase(Key) = 'Y' then begin
  432.             Assign(SaveF, SaveFN);
  433.             FileMode := 0;
  434.             Reset(SaveF, 1);
  435.             FileMode := 2;
  436.             BlockRead(SaveF, MinPWLen,  sizeof(MinPWLen));
  437.             BlockRead(SaveF, MaxPWLen,  sizeof(MaxPWLen));
  438.             BlockRead(SaveF, PWCharSet, sizeof(PWCharSet));
  439.             BlockRead(SaveF, PWLen,     sizeof(PWLen));
  440.             BlockRead(SaveF, NextPW,    sizeof(NextPW));
  441.             Close(SaveF);
  442.             GetRestartData := TRUE;
  443.         end;
  444.     end;
  445. end;
  446.  
  447. function ExecPkunzip(cmdline : String) : Integer;
  448. begin
  449.     SwapVectors;
  450.     Exec(PkunzipPath, cmdline);
  451.     SwapVectors;
  452.     if DosError <> 0 then begin
  453.         WriteLn('DOS Error ', DosError, ' executing ', PkunzipPath);
  454.         Halt(3);
  455.     end;
  456.     ExecPkunzip := DosExitCode;
  457. end;
  458.  
  459. procedure GetInput;
  460. var Key     : Char;
  461.     D     : DirStr;
  462.     N     : NameStr;
  463.     E     : ExtStr;
  464.     Done : Boolean;
  465.     rc     : Integer;
  466. begin
  467.     if not GetRestartData then begin
  468.         MinPWLen := PromptNumber('Minimum password length', 1, MAXPW);
  469.         if MinPWLen = MAXPW then MaxPWLen := MAXPW
  470.         else MaxPWLen := PromptNumber('Maximum password length', MinPWLen, MAXPW);
  471.         PromptCharSet('Password character set', PWCharSet);
  472.         if PWCharSet.n = 0 then begin
  473.             WriteLn('No characters in password character set!');
  474.             Halt(3);
  475.         end;
  476.     end;
  477.     PWSaveInt := PromptNumber('Password save interval', 0, 1000000);
  478.     Key := PromptChar('Use RAM Disk', 'YyNn');
  479.     if UpCase(Key) <> 'Y' then UseRamDisk := FALSE
  480.     else begin
  481.         UseRamDisk := TRUE;
  482.         Key := PromptChar('RAM Disk drive letter', 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ');
  483.         RamDrive := UpCase(Key);
  484.         RamPath := RamDrive + ':' + WorkDir;
  485.     end;
  486.  
  487.     PkunzipPath := FSearch('PKUNZIP.EXE', GetEnv('PATH'));
  488.     if PkunzipPath <> '' then PkunzipPath := FExpand(PkunzipPath)
  489.     else PkunzipPath := PromptFilename('PKUNZIP file name', 'EXE', GetEnv('PATH'));
  490.  
  491.     ZipfilePath := PromptFilename('Zip file name', 'ZIP', '');
  492.     FSplit(ZipfilePath, D, N, E);
  493.     ZipfileName := N + E;
  494.     Done := FALSE;
  495.     while not Done do begin
  496.         MemberName := PromptString('File to crack');
  497.         rc := ExecPkunzip('-# -v ' + ZipfilePath + ' ' + MemberName);
  498.         if rc <> 0 then WriteLn('Unable to locate ', MemberName, ' in ', ZipfilePath)
  499.         else Done := TRUE;
  500.     end;
  501. end;
  502.  
  503. function CopyFile(FromFile, ToFile : String) : Boolean;
  504. var pBuf     : CopyBufTP;
  505.     FromF    : File;
  506.     ToF         : File;
  507.     Count     : Word;
  508.     Written     : Word;
  509. begin
  510.     {$I-}
  511.     Assign(FromF, FromFile);
  512.     FileMode := 0;
  513.     Reset(FromF, 1);
  514.     FileMode := 2;
  515.     if IOResult <> 0 then begin
  516.         CopyFile := FALSE;
  517.         Exit;
  518.     end;
  519.     Assign(ToF, ToFile);
  520.     Rewrite(ToF, 1);
  521.     if IOResult <> 0 then begin
  522.         Close(FromF);
  523.         CopyFile := FALSE;
  524.         Exit;
  525.     end;
  526.     {$I+}
  527.     New(pBuf);
  528.     repeat
  529.         BlockRead(FromF, pBuf^, MAXBUF, Count);
  530.         BlockWrite(ToF, pBuf^, Count, Written);
  531.         if Written <> Count then begin
  532.             Close(FromF);
  533.             Close(ToF);
  534.             CopyFile := FALSE;
  535.             Dispose(pBuf);
  536.             Exit;
  537.         end;
  538.     until Count = 0;
  539.     Dispose(pBuf);
  540.     Close(FromF);
  541.     Close(ToF);
  542.     CopyFile := TRUE;
  543. end;
  544.  
  545. procedure SavePW;
  546. var SaveF : File;
  547. begin
  548.     Assign(SaveF, SaveFN);
  549.     Rewrite(SaveF, 1);
  550.     BlockWrite(SaveF, MinPWLen,  sizeof(MinPWLen));
  551.     BlockWrite(SaveF, MaxPWLen,  sizeof(MaxPWLen));
  552.     BlockWrite(SaveF, PWCharSet, sizeof(PWCharSet));
  553.     BlockWrite(SaveF, PWLen,     sizeof(PWLen));
  554.     BlockWrite(SaveF, NextPW,    sizeof(NextPW));
  555.     Close(SaveF);
  556. end;
  557.  
  558. function IncPW : Boolean;
  559. var n : Integer;
  560. begin
  561.     n := PWLen;
  562.     while TRUE do begin
  563.         if n = 0 then begin
  564.             IncPW := FALSE;
  565.             Exit;
  566.         end;
  567.         inc(NextPW[n]);
  568.         if NextPW[n] < PWCharSet.n then break
  569.         else NextPW[n] := 0;
  570.         dec(n);
  571.     end;
  572.     IncPW := TRUE;
  573. end;
  574.  
  575. procedure BuildPW(Escape : Boolean);
  576. var n : Integer;
  577.     m : Integer;
  578.     c : Char;
  579. begin
  580.     PW[0] := Chr(PWLen);
  581.     m := 1;
  582.     for n := 1 to PWLen do begin
  583.         c := PWCharSet.c[NextPW[n]];
  584.         if Escape and ((c = '"') or (c = '\')) then begin
  585.             PW[m] := '\';
  586.             inc(m);
  587.             inc(PW[0]);
  588.         end;
  589.         PW[m] := c;
  590.         inc(m);
  591.     end;
  592. end;
  593.  
  594. function CheckAllPWs : Boolean;
  595. var NextSave : LongInt;
  596.     Ok         : Boolean;
  597. begin
  598.  
  599.     NextSave := 1;
  600.  
  601.     while TRUE do begin
  602.  
  603.         if NextSave <> 0 then begin
  604.             if NextSave <> 1 then dec(NextSave)
  605.             else begin
  606.                 SavePW;
  607.                 NextSave := PWSaveInt;
  608.             end;
  609.         end;
  610.  
  611.         BuildPW(FALSE);
  612.         Ok := ZipPWCheck(PW, ZipBuf, ZDHdr.Crc32);
  613.  
  614.         if Ok then begin
  615.             BuildPW(TRUE);
  616.             rc := ExecPkunzip('-# -t -s"' + PW + '" ' + ZipfilePath + ' ' + MemberName);
  617.             if rc = 0 then begin
  618.                 CheckAllPWs := TRUE;
  619.                 Exit;
  620.             end;
  621.         end;
  622.  
  623.         Ok := IncPW;
  624.         if not Ok then begin
  625.             CheckAllPWs := FALSE;
  626.             Exit;
  627.         end;
  628.     end;
  629. end;
  630.  
  631. begin
  632.  
  633.     WriteLn('ZipCrack v1.0 Copyright 1993 by Michael A. Quinlan');
  634.  
  635.     GetInput;
  636.  
  637.     if UseRamDisk then begin
  638.         {$I-} MkDir(RamPath); {$I+}
  639.         if IOResult <> 0 then
  640.             ;
  641.         if not CopyFile(PkunzipPath, RamPath + '\PKUNZIP.EXE') then begin
  642.             WriteLn('Unable to copy ', PkunzipPath, ' to ', RamPath + '\PKUNZIP.EXE');
  643.             Exit;
  644.         end
  645.         else PkunzipPath := RamPath + '\PKUNZIP.EXE';
  646.         if not CopyFile(ZipfilePath, RamPath + '\' + ZipFilename) then begin
  647.             WriteLn('Unable to copy ', ZipfilePath, ' to ', RamPath + '\' + ZipFilename);
  648.             Exit;
  649.         end
  650.         else ZipfilePath := RamPath + '\' + ZipFilename;
  651.     end;
  652.  
  653. { Validate that PKUNZIP, the Zipfile, and the member of the Zipfile are }
  654. { still accessible.                                                        }
  655.  
  656.     rc := ExecPkunzip('-# -v ' + ZipfilePath + ' ' + MemberName);
  657.     if rc <> 0 then begin
  658.         WriteLn('Unable to locate ', MemberName, ' in ', ZipfilePath);
  659.         Halt(3);
  660.     end;
  661.  
  662.     Ok := ZipOpen(ZipFile, ZipfilePath, ZDEnd);
  663.     if not Ok then Halt(3);
  664.  
  665.     Ok := ZipFindFile(ZipFile, MemberName, ZDEnd, ZDHdr, ZIpHdr);
  666.     if not Ok then Halt(3);
  667.  
  668.     BlockRead(ZipFile, ZipBuf, sizeof(ZipBuf));
  669.  
  670.     if PWLen = 0 then PWLen := MinPWLen;
  671.     Writeln('Testing passwords...');
  672.     for PWLen := PWLen to MaxPWLen do begin
  673.         if CheckAllPWs then begin
  674.             Writeln('Password = "', PW, '"');
  675.             IncPW;
  676.             SavePW;
  677.             Halt(0);
  678.         end;
  679.     end;
  680.  
  681.     WriteLn('Password not found!!!');
  682.     Halt(1);
  683. end.
  684.